home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / front.lha / front / src / Listing.mi < prev    next >
Text File  |  1992-08-18  |  4KB  |  185 lines
  1. (* error listing *)
  2.  
  3. (* $Id: Listing.mi,v 1.3 1991/11/21 14:47:50 grosch rel $ *)
  4.  
  5. (* $Log: Listing.mi,v $
  6.  * Revision 1.3  1991/11/21  14:47:50  grosch
  7.  * new version of RCS on SPARC
  8.  *
  9.  * Revision 1.2  90/06/11  18:45:03  grosch
  10.  * layout improvements
  11.  * 
  12.  * Revision 1.1     89/01/23  15:46:50  vielsack
  13.  * fixed bug in handling no position
  14.  * 
  15.  * Revision 1.0     88/10/04  14:26:50  vielsack
  16.  * Initial revision
  17.  * 
  18.  *)
  19.  
  20. IMPLEMENTATION MODULE Listing;
  21.  
  22. FROM    IO        IMPORT    StdInput,    StdError,    tFile,
  23.                 EndOfFile,    WriteNl,    WriteC;
  24. FROM    Memory        IMPORT    Alloc,        Free;
  25. FROM    Strings        IMPORT    tString,    ReadL,        WriteL;
  26. FROM    SYSTEM        IMPORT    ADDRESS,    TSIZE;
  27.  
  28.  
  29. CONST
  30.   ColFlag  = '^';
  31.   LineFlag = '@';
  32.  
  33. TYPE
  34.   tErrPtr  =  POINTER TO tErrElmt;
  35.   tErrElmt =  RECORD
  36.         code, class, line, column, infcl   : SHORTCARD;
  37.         info    : ADDRESS;
  38.         next    : tErrPtr;
  39.           END;
  40.  
  41. VAR
  42.   start, stop, last, read: tErrPtr;
  43.   SourceLine : SHORTCARD;
  44.  
  45. PROCEDURE PutError (Code,Class,Line,Column,InfoClass: CARDINAL; Info: ADDRESS);
  46.   VAR err : tErrPtr;
  47.   BEGIN
  48.     err := Alloc (TSIZE (tErrElmt));
  49.     IF Line = 0 THEN Line := MAX (SHORTCARD) END;
  50.     WITH err^ DO
  51.       code    := Code;
  52.       class   := Class;
  53.       line    := Line;
  54.       column  := Column;
  55.       infcl   := InfoClass;
  56.       info    := Info;
  57.     END;
  58.  
  59.     IF start = NIL THEN
  60.                          (* list is emty *)
  61.       start := err;
  62.       read  := err;
  63.       stop  := err;
  64.       err^.next := NIL;
  65.       last  := err;
  66.  
  67.     ELSIF (Line < start^.line) OR
  68.     (  (Line = start^.line) & (Column < start^.column) ) THEN
  69.                         (* insert before start *)
  70.       err^.next := start;
  71.       start := err;
  72.       read  := err;
  73.     
  74.     ELSE                
  75.       IF (Line > stop^.line) OR
  76.       (     (Line = stop^.line) & (Column >= stop^.column)     )  THEN
  77.                         (* insert after stop    *)
  78.     last := stop;
  79.     stop := err;
  80.       ELSIF (Line > last^.line) OR
  81.       (     (Line = last^.line) & (Column >= last^.column)     )  THEN
  82.                         (* insert after last    *)
  83.     ;
  84.       ELSE
  85.                         (* insert after start    *)
  86.     last := start;
  87.       END;
  88.  
  89.  
  90.       WHILE (last^.next # NIL) &        
  91.        (   (Line > last^.next^.line) OR
  92.      ( (Line = last^.next^.line) & (Column >= last^.next^.column) )     ) DO
  93.                         (* find exact position *)
  94.     last := last^.next;
  95.       END;
  96.  
  97.       err^.next := last^.next;
  98.       last^.next := err;
  99.       last := err;
  100.     END;
  101.   END PutError;
  102.  
  103. PROCEDURE HasError (): BOOLEAN;
  104.   VAR Buf : tString;
  105.   BEGIN
  106.     IF start = NIL THEN
  107.       IF ListMode = Listing THEN
  108.     WHILE NOT EndOfFile (SourceFile) DO
  109.       ReadL (SourceFile, Buf);
  110.       WriteL (ListFile, Buf);
  111.     END;
  112.     WriteC (ListFile, LineFlag);
  113.       END;
  114.     END;
  115.     RETURN start # NIL;
  116.   END HasError;
  117.  
  118. PROCEDURE GetError (VAR Code,Class,Line,Column,InfoClass: CARDINAL; VAR Info: ADDRESS);
  119.   VAR
  120.     Next : tErrPtr;
  121.     col     : SHORTCARD;
  122.     Buf : tString;
  123.   BEGIN
  124.     WITH start^ DO
  125.       Code     := code;
  126.       Class     := class;
  127.       Line     := line;
  128.       Column     := column;
  129.       InfoClass     := infcl;
  130.       Info     := info;
  131.       Next     := next;
  132.     END;
  133.  
  134.     Free (TSIZE (tErrElmt), start);
  135.  
  136.     IF ListMode = Listing THEN
  137.       IF read = start THEN
  138.     LOOP
  139.       IF EndOfFile (SourceFile) THEN EXIT END;
  140.       IF SourceLine >= Line THEN EXIT END;
  141.       ReadL (SourceFile, Buf);
  142.       WriteL (ListFile, Buf);
  143.       INC (SourceLine);
  144.     END;
  145.     WriteC (ListFile, LineFlag);
  146.     col := 2;
  147.     WHILE (read # NIL) & (read^.line = Line) DO
  148.       WHILE (col < read^.column) DO
  149.         WriteC (ListFile, ' ');
  150.         INC (col);
  151.       END;
  152.       IF col = read^.column THEN
  153.         WriteC (ListFile, ColFlag);
  154.         INC (col);
  155.       END;
  156.       read := read^.next;
  157.     END;
  158.     WriteNl (ListFile);
  159.       END;
  160.       WriteC (ListFile, LineFlag);
  161.     END;
  162.  
  163.     IF last = start THEN
  164.       last := Next;
  165.     END;
  166.  
  167.     IF stop = start THEN
  168.       stop := Next;
  169.     END;
  170.  
  171.     start := Next;
  172.     IF Line = MAX (SHORTCARD) THEN Line := 0; END;
  173.   END GetError;
  174.  
  175. BEGIN
  176.   start := NIL;
  177.   read    := NIL;
  178.   stop    := NIL;
  179.   last    := NIL;
  180.   SourceFile := StdInput;
  181.   ListFile := StdError;
  182.   ListMode := NoListing;
  183.   SourceLine := 0;
  184. END Listing.
  185.